home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / strate1a / stratego.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1999-09-10  |  19.9 KB  |  592 lines
  1. VERSION 5.00
  2. Object = "{27395F88-0C0C-101B-A3C9-08002B2F49FB}#1.1#0"; "PICCLP32.OCX"
  3. Begin VB.Form StrategoG 
  4.    AutoRedraw      =   -1  'True
  5.    Caption         =   "Stratego Board"
  6.    ClientHeight    =   5475
  7.    ClientLeft      =   60
  8.    ClientTop       =   345
  9.    ClientWidth     =   8265
  10.    LinkTopic       =   "Form1"
  11.    ScaleHeight     =   365
  12.    ScaleMode       =   3  'Pixel
  13.    ScaleWidth      =   551
  14.    StartUpPosition =   3  'Windows Default
  15.    Begin VB.CommandButton Command1 
  16.       Caption         =   "Start The Game"
  17.       Height          =   375
  18.       Left            =   5520
  19.       TabIndex        =   1
  20.       Top             =   4920
  21.       Width           =   1575
  22.    End
  23.    Begin VB.PictureBox Picture1 
  24.       AutoRedraw      =   -1  'True
  25.       AutoSize        =   -1  'True
  26.       BackColor       =   &H00000000&
  27.       BorderStyle     =   0  'None
  28.       Height          =   5490
  29.       Left            =   0
  30.       Picture         =   "StrategoG.frx":0000
  31.       ScaleHeight     =   366
  32.       ScaleMode       =   3  'Pixel
  33.       ScaleWidth      =   550
  34.       TabIndex        =   0
  35.       Top             =   0
  36.       Width           =   8250
  37.       Begin VB.CommandButton Command2 
  38.          Caption         =   "Quit"
  39.          Height          =   375
  40.          Left            =   7200
  41.          TabIndex        =   15
  42.          Top             =   4920
  43.          Width           =   855
  44.       End
  45.       Begin PicClip.PictureClip PictureClip2 
  46.          Left            =   -480
  47.          Top             =   5880
  48.          _ExtentX        =   9525
  49.          _ExtentY        =   794
  50.          _Version        =   393216
  51.          Picture         =   "StrategoG.frx":D402
  52.       End
  53.       Begin PicClip.PictureClip PictureClip3 
  54.          Left            =   7320
  55.          Top             =   5880
  56.          _ExtentX        =   1588
  57.          _ExtentY        =   794
  58.          _Version        =   393216
  59.          Picture         =   "StrategoG.frx":152E4
  60.       End
  61.       Begin PicClip.PictureClip PictureClip1 
  62.          Left            =   6240
  63.          Top             =   5880
  64.          _ExtentX        =   1799
  65.          _ExtentY        =   900
  66.          _Version        =   393216
  67.          Picture         =   "StrategoG.frx":1684E
  68.       End
  69.       Begin VB.Image Image1 
  70.          Height          =   1020
  71.          Left            =   5160
  72.          Picture         =   "StrategoG.frx":183B8
  73.          Top             =   5880
  74.          Visible         =   0   'False
  75.          Width           =   1020
  76.       End
  77.       Begin VB.Shape Shape3 
  78.          BorderColor     =   &H0000FF00&
  79.          BorderWidth     =   2
  80.          Height          =   2055
  81.          Left            =   225
  82.          Top             =   3240
  83.          Visible         =   0   'False
  84.          Width           =   5055
  85.       End
  86.       Begin VB.Label Label2 
  87.          Alignment       =   2  'Center
  88.          BackStyle       =   0  'Transparent
  89.          Caption         =   "Start a New Game"
  90.          BeginProperty Font 
  91.             Name            =   "Lucida Sans"
  92.             Size            =   12
  93.             Charset         =   0
  94.             Weight          =   700
  95.             Underline       =   0   'False
  96.             Italic          =   -1  'True
  97.             Strikethrough   =   0   'False
  98.          EndProperty
  99.          ForeColor       =   &H00FFFFFF&
  100.          Height          =   255
  101.          Left            =   5520
  102.          TabIndex        =   14
  103.          Top             =   240
  104.          Width           =   2535
  105.       End
  106.       Begin VB.Shape Shape2 
  107.          BorderColor     =   &H0000FFFF&
  108.          BorderWidth     =   2
  109.          Height          =   495
  110.          Left            =   2280
  111.          Top             =   1680
  112.          Visible         =   0   'False
  113.          Width           =   495
  114.       End
  115.       Begin VB.Label Label1 
  116.          BackStyle       =   0  'Transparent
  117.          Caption         =   "1"
  118.          BeginProperty Font 
  119.             Name            =   "MS Sans Serif"
  120.             Size            =   8.25
  121.             Charset         =   0
  122.             Weight          =   700
  123.             Underline       =   0   'False
  124.             Italic          =   0   'False
  125.             Strikethrough   =   0   'False
  126.          EndProperty
  127.          ForeColor       =   &H0000FFFF&
  128.          Height          =   255
  129.          Index           =   11
  130.          Left            =   7860
  131.          TabIndex        =   13
  132.          Top             =   2040
  133.          Width           =   135
  134.       End
  135.       Begin VB.Label Label1 
  136.          BackStyle       =   0  'Transparent
  137.          Caption         =   "1"
  138.          BeginProperty Font 
  139.             Name            =   "MS Sans Serif"
  140.             Size            =   8.25
  141.             Charset         =   0
  142.             Weight          =   700
  143.             Underline       =   0   'False
  144.             Italic          =   0   'False
  145.             Strikethrough   =   0   'False
  146.          EndProperty
  147.          ForeColor       =   &H0000FFFF&
  148.          Height          =   255
  149.          Index           =   10
  150.          Left            =   7860
  151.          TabIndex        =   12
  152.          Top             =   1440
  153.          Width           =   135
  154.       End
  155.       Begin VB.Label Label1 
  156.          BackStyle       =   0  'Transparent
  157.          Caption         =   "8"
  158.          BeginProperty Font 
  159.             Name            =   "MS Sans Serif"
  160.             Size            =   8.25
  161.             Charset         =   0
  162.             Weight          =   700
  163.             Underline       =   0   'False
  164.             Italic          =   0   'False
  165.             Strikethrough   =   0   'False
  166.          EndProperty
  167.          ForeColor       =   &H0000FFFF&
  168.          Height          =   255
  169.          Index           =   9
  170.          Left            =   7860
  171.          TabIndex        =   11
  172.          Top             =   840
  173.          Width           =   135
  174.       End
  175.       Begin VB.Label Label1 
  176.          BackStyle       =   0  'Transparent
  177.          Caption         =   "5"
  178.          BeginProperty Font 
  179.             Name            =   "MS Sans Serif"
  180.             Size            =   8.25
  181.             Charset         =   0
  182.             Weight          =   700
  183.             Underline       =   0   'False
  184.             Italic          =   0   'False
  185.             Strikethrough   =   0   'False
  186.          EndProperty
  187.          ForeColor       =   &H0000FFFF&
  188.          Height          =   255
  189.          Index           =   8
  190.          Left            =   7230
  191.          TabIndex        =   10
  192.          Top             =   2040
  193.          Width           =   135
  194.       End
  195.       Begin VB.Label Label1 
  196.          BackStyle       =   0  'Transparent
  197.          Caption         =   "4"
  198.          BeginProperty Font 
  199.             Name            =   "MS Sans Serif"
  200.             Size            =   8.25
  201.             Charset         =   0
  202.             Weight          =   700
  203.             Underline       =   0   'False
  204.             Italic          =   0   'False
  205.             Strikethrough   =   0   'False
  206.          EndProperty
  207.          ForeColor       =   &H0000FFFF&
  208.          Height          =   255
  209.          Index           =   7
  210.          Left            =   7230
  211.          TabIndex        =   9
  212.          Top             =   1440
  213.          Width           =   135
  214.       End
  215.       Begin VB.Label Label1 
  216.          BackStyle       =   0  'Transparent
  217.          Caption         =   "4"
  218.          BeginProperty Font 
  219.             Name            =   "MS Sans Serif"
  220.             Size            =   8.25
  221.             Charset         =   0
  222.             Weight          =   700
  223.             Underline       =   0   'False
  224.             Italic          =   0   'False
  225.             Strikethrough   =   0   'False
  226.          EndProperty
  227.          ForeColor       =   &H0000FFFF&
  228.          Height          =   255
  229.          Index           =   6
  230.          Left            =   7230
  231.          TabIndex        =   8
  232.          Top             =   840
  233.          Width           =   135
  234.       End
  235.       Begin VB.Label Label1 
  236.          BackStyle       =   0  'Transparent
  237.          Caption         =   "4"
  238.          BeginProperty Font 
  239.             Name            =   "MS Sans Serif"
  240.             Size            =   8.25
  241.             Charset         =   0
  242.             Weight          =   700
  243.             Underline       =   0   'False
  244.             Italic          =   0   'False
  245.             Strikethrough   =   0   'False
  246.          EndProperty
  247.          ForeColor       =   &H0000FFFF&
  248.          Height          =   255
  249.          Index           =   5
  250.          Left            =   6630
  251.          TabIndex        =   7
  252.          Top             =   2040
  253.          Width           =   135
  254.       End
  255.       Begin VB.Label Label1 
  256.          BackStyle       =   0  'Transparent
  257.          Caption         =   "3"
  258.          BeginProperty Font 
  259.             Name            =   "MS Sans Serif"
  260.             Size            =   8.25
  261.             Charset         =   0
  262.             Weight          =   700
  263.             Underline       =   0   'False
  264.             Italic          =   0   'False
  265.             Strikethrough   =   0   'False
  266.          EndProperty
  267.          ForeColor       =   &H0000FFFF&
  268.          Height          =   255
  269.          Index           =   4
  270.          Left            =   6630
  271.          TabIndex        =   6
  272.          Top             =   1440
  273.          Width           =   135
  274.       End
  275.       Begin VB.Label Label1 
  276.          BackStyle       =   0  'Transparent
  277.          Caption         =   "2"
  278.          BeginProperty Font 
  279.             Name            =   "MS Sans Serif"
  280.             Size            =   8.25
  281.             Charset         =   0
  282.             Weight          =   700
  283.             Underline       =   0   'False
  284.             Italic          =   0   'False
  285.             Strikethrough   =   0   'False
  286.          EndProperty
  287.          ForeColor       =   &H0000FFFF&
  288.          Height          =   255
  289.          Index           =   3
  290.          Left            =   6630
  291.          TabIndex        =   5
  292.          Top             =   840
  293.          Width           =   135
  294.       End
  295.       Begin VB.Label Label1 
  296.          BackStyle       =   0  'Transparent
  297.          Caption         =   "1"
  298.          BeginProperty Font 
  299.             Name            =   "MS Sans Serif"
  300.             Size            =   8.25
  301.             Charset         =   0
  302.             Weight          =   700
  303.             Underline       =   0   'False
  304.             Italic          =   0   'False
  305.             Strikethrough   =   0   'False
  306.          EndProperty
  307.          ForeColor       =   &H0000FFFF&
  308.          Height          =   255
  309.          Index           =   2
  310.          Left            =   6030
  311.          TabIndex        =   4
  312.          Top             =   2040
  313.          Width           =   135
  314.       End
  315.       Begin VB.Label Label1 
  316.          BackStyle       =   0  'Transparent
  317.          Caption         =   "1"
  318.          BeginProperty Font 
  319.             Name            =   "MS Sans Serif"
  320.             Size            =   8.25
  321.             Charset         =   0
  322.             Weight          =   700
  323.             Underline       =   0   'False
  324.             Italic          =   0   'False
  325.             Strikethrough   =   0   'False
  326.          EndProperty
  327.          ForeColor       =   &H0000FFFF&
  328.          Height          =   255
  329.          Index           =   1
  330.          Left            =   6030
  331.          TabIndex        =   3
  332.          Top             =   1440
  333.          Width           =   135
  334.       End
  335.       Begin VB.Label Label1 
  336.          BackStyle       =   0  'Transparent
  337.          Caption         =   "6"
  338.          BeginProperty Font 
  339.             Name            =   "MS Sans Serif"
  340.             Size            =   8.25
  341.             Charset         =   0
  342.             Weight          =   700
  343.             Underline       =   0   'False
  344.             Italic          =   0   'False
  345.             Strikethrough   =   0   'False
  346.          EndProperty
  347.          ForeColor       =   &H0000FFFF&
  348.          Height          =   255
  349.          Index           =   0
  350.          Left            =   6030
  351.          TabIndex        =   2
  352.          Top             =   840
  353.          Width           =   135
  354.       End
  355.       Begin VB.Shape Shape1 
  356.          BorderColor     =   &H0000FFFF&
  357.          BorderWidth     =   2
  358.          Height          =   495
  359.          Left            =   5520
  360.          Top             =   840
  361.          Visible         =   0   'False
  362.          Width           =   495
  363.       End
  364.    End
  365. Attribute VB_Name = "StrategoG"
  366. Attribute VB_GlobalNameSpace = False
  367. Attribute VB_Creatable = False
  368. Attribute VB_PredeclaredId = True
  369. Attribute VB_Exposed = False
  370. '********************************
  371. '**  Subject :Stratego Game OCX
  372. '**  Credit  :Carl Harvey
  373. '**  Date    :02-1999
  374. '**  Info    :elterrorista@videotron.ca
  375. '********************************
  376. Dim DiffBoard, DiffBoardy As Integer 'Variable de Difference entre le bord de gauche et le debut du Board
  377. Dim DiffPitinitx, DiffPitinity As Integer 'Variable de Difference entre le haut et le debut du Board
  378. Dim OkPlacePiece As Boolean
  379. Dim BoardPit(0 To 3, 0 To 2)
  380. Dim BoardBoard(0 To 9, 0 To 9)
  381. Dim CharacterT(0 To 11)
  382. Dim MetCettePit As Integer
  383. Dim PartienCour As Boolean
  384. Dim NbPieceOnBoard As Integer
  385. Dim Selected As Boolean
  386. Dim PitSelected
  387. Dim EatOtherPiece As Boolean
  388. Dim selection(0 To 1)
  389. Private Sub Command1_Click()
  390. initGame
  391. End Sub
  392. Private Sub Command2_Click()
  393. End Sub
  394. Private Sub Form_Load()
  395. PictureClip1.Cols = 2
  396. PictureClip2.Cols = 12
  397. PictureClip3.Cols = 2
  398. DiffBoard = 13: DiffBoardy = 13 'Pixel
  399. DiffPitinitx = 370: DiffPitinity = 60 'Pixel
  400. Initaffichegrade
  401. DrawBoard
  402. DrawPitouneInit
  403. End Sub
  404. Public Sub initGame()
  405. OkPlacePiece = True
  406. MetCettePit = 0
  407. DrawBoard
  408. DrawPitouneInit
  409. Initvalpitamettre
  410. Shape1.Visible = True: Shape2.Visible = True: Shape3.Visible = True
  411. Label2.Caption = "Bombe"
  412. Shape1.Left = DiffPitinitx
  413. Shape1.Top = DiffPitinity
  414. MetCettePit = 0
  415. NbPieceOnBoard = 0
  416. DrawBoardJ2
  417. PartienCour = True
  418. End Sub
  419. Private Sub Initvalpitamettre()
  420. 'Met le nombre de pitoune pour chaque pitoune
  421. 'show the number of piece for each charter
  422. Label1(0).Caption = 6: Label1(1).Caption = 1: Label1(2).Caption = 1: Label1(3).Caption = 2: Label1(4).Caption = 3: Label1(5).Caption = 4: Label1(6).Caption = 4: Label1(7).Caption = 4: Label1(8).Caption = 5: Label1(9).Caption = 8: Label1(10).Caption = 1: Label1(11).Caption = 1
  423. End Sub
  424. Private Sub DrawBoard()
  425. 'Draw le Board Pieces verte
  426. 'draw the green on the board
  427. Dim i, i2 As Integer
  428. For i = 0 To 9
  429.   For i2 = 0 To 9
  430.    Picture1.PaintPicture PictureClip1.GraphicCell(1), i * 34 + DiffBoard, i2 * 34 + DiffBoardy
  431.    BoardBoard(i, i2) = -1
  432.   Next i2
  433. Next i
  434. 'Draw le Board Pieces bleu(Lac)
  435. 'draw blue pieces
  436.  BoardBoard(2, 4) = -2: BoardBoard(3, 4) = -2
  437.  BoardBoard(2, 5) = -2: BoardBoard(3, 5) = -2
  438.  BoardBoard(6, 4) = -2: BoardBoard(7, 4) = -2
  439.  BoardBoard(6, 5) = -2: BoardBoard(7, 5) = -2
  440.  Picture1.PaintPicture Image1.Picture, 2 * 34 + DiffBoard, 4 * 34 + DiffBoardy
  441.  Picture1.PaintPicture Image1.Picture, 6 * 34 + DiffBoard, 4 * 34 + DiffBoardy
  442. End Sub
  443. Private Sub DrawPitouneInit()
  444. Dim nb, i, i2 As Integer
  445. For i = 0 To 3
  446.   For i2 = 0 To 2
  447.    Picture1.PaintPicture PictureClip2.GraphicCell(nb), i * 40 + DiffPitinitx, i2 * 40 + DiffPitinity
  448.    BoardPit(i, i2) = nb
  449.    nb = nb + 1
  450.   Next i2
  451. Next i
  452. End Sub
  453. Private Sub DrawBoardJ2()
  454. Dim i, i2 As Integer
  455. For i = 0 To 9
  456.   For i2 = 0 To 3
  457.      Picture1.PaintPicture PictureClip3.GraphicCell(1), i * 34 + (DiffBoard + 2), i2 * 34 + (DiffBoardy + 2)
  458.   Next i2
  459. Next i
  460. End Sub
  461. Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  462.  If OkPlacePiece Then
  463.    Dim temp1, temp2
  464.    If X > 360 And Y > 60 And X < 520 And Y < 170 Then
  465.     'devant les Pitounes a placer
  466.     temp1 = Int((X - 360) / 40)
  467.     temp2 = Int((Y - 60) / 40)
  468.     MetCettePit = BoardPit(temp1, temp2)
  469.     Shape1.Left = temp1 * 40 + DiffPitinitx
  470.     Shape1.Top = temp2 * 40 + DiffPitinity
  471.     Label2.Caption = CharacterT(MetCettePit)
  472.    Else
  473.    'Devant le Board
  474.    If X > DiffBoard And Y > DiffBoardy + 205 And X < 350 And Y < 350 Then
  475.     temp1 = Int((X - DiffBoard) / 34)
  476.     temp2 = Int((Y - DiffBoardy) / 34)
  477.     If BoardBoard(temp1, temp2) <> -1 Then EnlevePit temp1, temp2: Exit Sub
  478.     If Val(Label1(MetCettePit).Caption) > 0 Then
  479.     NbPieceOnBoard = NbPieceOnBoard + 1
  480.     MetPitounesurtab temp1, temp2, MetCettePit
  481.     End If
  482.     If NbPieceOnBoard = 40 Then
  483.      Dim rep
  484.      rep = MsgBox("You have finish ?", vbYesNo, "Qestion")
  485.      If rep = vbYes Then
  486.       OkPlacePiece = False
  487.       Shape3.Visible = False
  488.       Shape1.Visible = False
  489.      Else
  490.       EnlevePit temp1, temp2: Exit Sub
  491.      End If
  492.     End If
  493.     End If
  494.    End If
  495.  Else
  496.   If X > DiffBoard And Y > DiffBoardy And X < 350 And Y < 350 Then
  497.     temp1 = Int((X - DiffBoard) / 34)
  498.     temp2 = Int((Y - DiffBoardy) / 34)
  499.     If Selected Then
  500.      If temp1 = selection(0) And temp2 = selection(1) Then
  501.       Selected = False
  502.       PitSelected = -1
  503.       selection(0) = -1
  504.       selection(1) = -1
  505.       Shape2.BorderColor = &HFFFF&
  506.       Exit Sub
  507.      End If
  508.      'if scout
  509.      
  510.      If (Abs(temp1 - selection(0)) = 1 And temp2 = selection(1)) Or (Abs(temp2 - selection(1)) = 1 And (temp1 = selection(0))) Then
  511.        If BoardBoard(temp1, temp2) > 12 Then
  512.          'Check Mange l'autre
  513.          MsgBox "Eat Other Piece"
  514.        Else
  515.        If BoardBoard(temp1, temp2) = -1 Then
  516.         Bougepiece temp1, temp2
  517.        End If
  518.        End If
  519.      End If
  520.     Else
  521.     If BoardBoard(temp1, temp2) > 0 And BoardBoard(temp1, temp2) < 11 Then
  522.       Selected = True
  523.       PitSelected = BoardBoard(temp1, temp2)
  524.       selection(0) = temp1
  525.       selection(1) = temp2
  526.      Shape2.BorderColor = &HFF&
  527.     End If
  528.     End If
  529.   End If
  530. End If
  531. End Sub
  532. Private Sub Bougepiece(ind1, ind2)
  533. BoardBoard(ind1, ind2) = BoardBoard(selection(0), selection(1))
  534. BoardBoard(selection(0), selection(1)) = -1
  535. Picture1.PaintPicture PictureClip1.GraphicCell(1), selection(0) * 34 + DiffBoard, selection(1) * 34 + DiffBoardy
  536. MetPitounesurtab ind1, ind2, PitSelected
  537. selection(0) = -1: selection(1) = -1
  538. Selected = False
  539. Shape2.Visible = False
  540. Shape2.BorderColor = &HFFFF&
  541. End Sub
  542. Private Sub EnlevePit(ind1, ind2)
  543.  Picture1.PaintPicture PictureClip1.GraphicCell(1), ind1 * 34 + DiffBoard, ind2 * 34 + DiffBoardy
  544.  Label1(BoardBoard(ind1, ind2)).Caption = Val(Label1(BoardBoard(ind1, ind2)).Caption) + 1
  545.  BoardBoard(ind1, ind2) = -1
  546.  NbPieceOnBoard = NbPieceOnBoard - 1
  547. End Sub
  548. Private Sub MetPitounesurtab(ind1, ind2, pit)
  549.  Picture1.PaintPicture PictureClip2.GraphicCell(pit), ind1 * 34 + DiffBoard + 2, ind2 * 34 + DiffBoardy + 2
  550.  BoardBoard(ind1, ind2) = pit
  551.  If OkPlacePiece Then Label1(pit).Caption = Val(Label1(pit).Caption) - 1
  552. End Sub
  553. Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  554.  If PartienCour Then
  555.   If Not Selected Then
  556.    Dim temp1, temp2
  557.    temp1 = Int((X - DiffBoard) / 34)
  558.    temp2 = Int((Y - DiffBoardy) / 34)
  559.    If X > DiffBoard And Y > DiffBoardy And X < 350 And Y < 350 Then
  560.    If (OkPlacePiece And (X > DiffBoard And Y > DiffBoardy + 205 And X < 350 And Y < 350)) Or (Not temdeplacerpit And (BoardBoard(temp1, temp2) > 0 And BoardBoard(temp1, temp2) < 11)) Then
  561.      Shape2.Visible = True
  562.       If Shape2.Left <> temp1 * 34 + DiffBoard Or Shape2.Top <> temp2 * 34 + DiffBoardy Then
  563.         Shape2.Left = temp1 * 34 + DiffBoard
  564.         Shape2.Top = temp2 * 34 + DiffBoard
  565.       End If
  566.     Else
  567.       Shape2.Visible = False
  568.     End If
  569.    Else
  570.     Shape2.Visible = False
  571.    End If
  572.    End If
  573.  End If
  574. End Sub
  575. Private Sub Initaffichegrade()
  576.  CharacterT(0) = "Bombe"
  577.  CharacterT(1) = "Marshal"
  578.  CharacterT(2) = "G
  579. rale"
  580.  CharacterT(3) = "Colonel"
  581.  CharacterT(4) = "Major"
  582.  CharacterT(5) = "Capitaine"
  583.  CharacterT(6) = "Lieutenant"
  584.  CharacterT(7) = "Sergent"
  585.  CharacterT(8) = "D
  586. mineur"
  587.  CharacterT(9) = "
  588. claireur"
  589.  CharacterT(10) = "Espion"
  590.  CharacterT(11) = "Drapeau"
  591. End Sub
  592.